home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / tgeni386.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  20KB  |  653 lines
  1. {
  2.     $Id: tgeni386.pas,v 1.1.1.1 1998/03/25 11:18:15 root Exp $
  3.     Copyright (C) 1993-98 by Florian Klaempfl
  4.  
  5.     This unit handles the temporary variables stuff for i386
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23. unit tgeni386;
  24.  
  25.   interface
  26.  
  27.     uses
  28.        cobjects,globals,tree,hcodegen,verbose,files,aasm
  29. {$ifdef i386}
  30.        ,i386
  31. {$endif}
  32.        ;
  33.  
  34.     type
  35.        tregisterset = set of tregister;
  36.  
  37.        tpushed = array[R_EAX..R_MM6] of boolean;
  38.  
  39.     const
  40.        usablereg32 : byte = 4;
  41. {$ifdef SUPPORT_MMX}
  42.        usableregmmx : byte = 8;
  43. {$endif SUPPORT_MMX}
  44.  
  45.     function getregister32 : tregister;
  46.     procedure ungetregister32(r : tregister);
  47. {$ifdef SUPPORT_MMX}
  48.     function getregistermmx : tregister;
  49.     procedure ungetregistermmx(r : tregister);
  50. {$endif SUPPORT_MMX}
  51.  
  52.     procedure ungetregister(r : tregister);
  53.  
  54.     procedure cleartempgen;
  55.  
  56.     { generates temporary variables }
  57.     procedure resettempgen;
  58.     procedure setfirsttemp(l : longint);
  59.     function gettempsize : longint;
  60.     function gettempofsize(size : longint) : longint;
  61.     procedure gettempofsizereference(l : longint;var ref : treference);
  62.     function istemp(const ref : treference) : boolean;
  63.     procedure ungetiftemp(const ref : treference);
  64.  
  65.     procedure del_reference(const ref : treference);
  66.     procedure del_locref(const location : tlocation);
  67.  
  68.  
  69.     { pushs and restores registers }
  70.     procedure pushusedregisters(var pushed : tpushed;b : byte);
  71.     procedure popusedregisters(const pushed : tpushed);
  72.  
  73.     var
  74.        unused,usableregs : tregisterset;
  75.        c_usableregs : longint;
  76.  
  77.        { uses only 1 byte while a set uses in FPC 32 bytes }
  78.        usedinproc : byte;
  79.  
  80.        { count, how much a register must be pushed if it is used as register }
  81.        { variable                                                            }
  82. {$ifdef SUPPORT_MMX}
  83.        reg_pushes : array[R_EAX..R_MM6] of longint;
  84.        is_reg_var : array[R_EAX..R_MM6] of boolean;
  85. {$else SUPPORT_MMX}
  86.        reg_pushes : array[R_EAX..R_EDI] of longint;
  87.        is_reg_var : array[R_EAX..R_EDI] of boolean;
  88. {$endif SUPPORT_MMX}
  89.   implementation
  90.  
  91.     procedure pushusedregisters(var pushed : tpushed;b : byte);
  92.  
  93.       var
  94.          r : tregister;
  95.          hr : preference;
  96.  
  97.       begin
  98.          usedinproc:=usedinproc or b;
  99.          for r:=R_EAX to R_EBX do
  100.            begin
  101.               pushed[r]:=false;
  102.               { if the register is used by the calling subroutine    }
  103.               if ((b and ($80 shr byte(r)))<>0) then
  104.                 begin
  105.                    { and is present in use }
  106.                    if not(r in unused) then
  107.                      begin
  108.                         { then save it }
  109.                         exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r)));
  110.                         { here was a big problem  !!!!!}
  111.                         { you cannot do that for a register that is
  112.                         globally assigned to a var
  113.                         this also means that you must push it much more
  114.                         often, but there must be a better way
  115.                         maybe by putting the value back to the stack !! }
  116.                         if not(is_reg_var[r]) then
  117.                           unused:=unused+[r];
  118.                         pushed[r]:=true;
  119.                      end;
  120.                 end;
  121.            end;
  122. {$ifdef SUPPORT_MMX}
  123.          for r:=R_MM0 to R_MM6 do
  124.            begin
  125.               pushed[r]:=false;
  126.               { if the mmx register is in use, save it }
  127.               if not(r in unused) then
  128.                 begin
  129.                    exprasmlist^.concat(new(pai386,op_const_reg(
  130.                      A_SUB,S_L,8,R_ESP)));
  131.                    new(hr);
  132.                    reset_reference(hr^);
  133.                    hr^.base:=R_ESP;
  134.                    exprasmlist^.concat(new(pai386,op_reg_ref(
  135.                      A_MOVQ,S_NO,r,hr)));
  136.                    if not(is_reg_var[r]) then
  137.                      unused:=unused+[r];
  138.                    pushed[r]:=true;
  139.                 end;
  140.            end;
  141. {$endif SUPPORT_MMX}
  142.       end;
  143.  
  144.     procedure popusedregisters(const pushed : tpushed);
  145.  
  146.       var
  147.          r : tregister;
  148.          hr : preference;
  149.  
  150.       begin
  151.          { restore in reverse order: }
  152. {$ifdef SUPPORT_MMX}
  153.          for r:=R_MM6 downto R_MM0 do
  154.            begin
  155.               if pushed[r] then
  156.                 begin
  157.                    new(hr);
  158.                    reset_reference(hr^);
  159.                    hr^.base:=R_ESP;
  160.                    exprasmlist^.concat(new(pai386,op_ref_reg(
  161.                      A_MOVQ,S_NO,hr,r)));
  162.                    exprasmlist^.concat(new(pai386,op_const_reg(
  163.                      A_ADD,S_L,8,R_ESP)));
  164.                    unused:=unused-[r];
  165.                 end;
  166.            end;
  167. {$endif SUPPORT_MMX}
  168.          for r:=R_EBX downto R_EAX do
  169.            if pushed[r] then
  170.              begin
  171.                 exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,r)));
  172.                 unused:=unused-[r];
  173.              end;
  174.       end;
  175.  
  176.     procedure ungetregister(r : tregister);
  177.  
  178.       begin
  179.          if r in [R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI] then
  180.            ungetregister32(r)
  181.          else if r in [R_AX,R_CX,R_DX,R_BX,R_SP,R_BP,R_SI,R_DI] then
  182.            ungetregister32(reg16toreg32(r))
  183.          else if r in [R_AL,R_BL,R_CL,R_DL] then
  184.            ungetregister32(reg8toreg32(r))
  185. {$ifdef SUPPORT_MMX}
  186.          else if r in [R_MM0..R_MM6] then
  187.            ungetregistermmx(r)
  188. {$endif SUPPORT_MMX}
  189.          else internalerror(18);
  190.       end;
  191.  
  192.     procedure ungetregister32(r : tregister);
  193.  
  194.       begin
  195.          if cs_maxoptimieren in aktswitches then
  196.            begin
  197.               { takes much time }
  198.               if not(r in usableregs) then
  199.                 exit;
  200.               unused:=unused+[r];
  201.               inc(usablereg32);
  202.            end
  203.          else
  204.            begin
  205.               if not(r in [R_EAX,R_EBX,R_ECX,R_EDX]) then
  206.                 exit;
  207.               unused:=unused+[r];
  208.               inc(usablereg32);
  209.            end;
  210.       end;
  211.  
  212. {$ifdef SUPPORT_MMX}
  213.     function getregistermmx : tregister;
  214.  
  215.       var
  216.          r : tregister;
  217.  
  218.       begin
  219.          dec(usableregmmx);
  220.          for r:=R_MM0 to R_MM6 do
  221.            if r in unused then
  222.              begin
  223.                 unused:=unused-[r];
  224.                 usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  225.                 getregistermmx:=r;
  226.                 exit;
  227.              end;
  228.          internalerror(10);
  229.       end;
  230.  
  231.     procedure ungetregistermmx(r : tregister);
  232.  
  233.       begin
  234.          if cs_maxoptimieren in aktswitches then
  235.            begin
  236.               { takes much time }
  237.               if not(r in usableregs) then
  238.                 exit;
  239.               unused:=unused+[r];
  240.               inc(usableregmmx);
  241.            end
  242.          else
  243.            begin
  244.               unused:=unused+[r];
  245.               inc(usableregmmx);
  246.            end;
  247.       end;
  248. {$endif SUPPORT_MMX}
  249.  
  250.     procedure del_reference(const ref : treference);
  251.  
  252.       begin
  253.          if ref.isintvalue then
  254.            exit;
  255.          ungetregister32(ref.base);
  256.          ungetregister32(ref.index);
  257.          { ref.segment:=R_DEFAULT_SEG; }
  258.       end;
  259.  
  260.     procedure del_locref(const location : tlocation);
  261.  
  262.       begin
  263.          if (location.loc<>loc_mem) and (location.loc<>loc_reference) then
  264.            exit;
  265.          if location.reference.isintvalue then
  266.            exit;
  267.          ungetregister32(location.reference.base);
  268.          ungetregister32(location.reference.index);
  269.          { ref.segment:=R_DEFAULT_SEG; }
  270.       end;
  271.  
  272.     function getregister32 : tregister;
  273.  
  274.       begin
  275.          dec(usablereg32);
  276.          if R_EAX in unused then
  277.            begin
  278.               unused:=unused-[R_EAX];
  279.               usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  280.               getregister32:=R_EAX;
  281.            end
  282.          else if R_EDX in unused then
  283.            begin
  284.               unused:=unused-[R_EDX];
  285.               usedinproc:=usedinproc or ($80 shr byte(R_EDX));
  286.               getregister32:=R_EDX;
  287.            end
  288.          else if R_EBX in unused then
  289.            begin
  290.               unused:=unused-[R_EBX];
  291.               usedinproc:=usedinproc or ($80 shr byte(R_EBX));
  292.               getregister32:=R_EBX;
  293.            end
  294.          else if R_ECX in unused then
  295.            begin
  296.               unused:=unused-[R_ECX];
  297.               usedinproc:=usedinproc or ($80 shr byte(R_ECX));
  298.               getregister32:=R_ECX;
  299.            end
  300.          else internalerror(10);
  301.       end;
  302.  
  303.     procedure cleartempgen;
  304.  
  305.       begin
  306.          unused:=usableregs;
  307.          usablereg32:=c_usableregs;
  308.       end;
  309.  
  310.     type
  311.        pfreerecord = ^tfreerecord;
  312.  
  313.        tfreerecord = record
  314.           next : pfreerecord;
  315.           pos : longint;
  316.           size : longint;
  317. {$ifdef EXTDEBUG}
  318.           line : longint;
  319. {$endif}
  320.        end;
  321.  
  322.     var
  323.        tmpfreelist : pfreerecord;
  324.        templist : pfreerecord;
  325.        lastoccupied : longint;
  326.        firsttemp, maxtemp : longint;
  327.  
  328.     procedure resettempgen;
  329.  
  330.       var
  331.          hp : pfreerecord;
  332.  
  333.       begin
  334.          while assigned(tmpfreelist) do
  335.            begin
  336.               hp:=tmpfreelist;
  337.               tmpfreelist:=hp^.next;
  338.               dispose(hp);
  339.            end;
  340.          while assigned(templist) do
  341.            begin
  342. {$ifdef EXTDEBUG}
  343.               Comment(V_Warning,'temporary assignment of size '
  344.                        +tostr(templist^.size)+' from '+tostr(templist^.line)+
  345.                        +' at pos '+tostr(templist^.pos)+
  346.                        ' not freed at the end of the procedure');
  347. {$endif}
  348.               hp:=templist;
  349.               templist:=hp^.next;
  350. {$ifndef EXTDEBUG}
  351.               dispose(hp);
  352. {$endif not EXTDEBUG}
  353.            end;
  354.          templist:=nil;
  355.          tmpfreelist:=nil;
  356.          firsttemp:=0;
  357.          maxtemp:=0;
  358.          lastoccupied:=0;
  359.       end;
  360.  
  361.     procedure setfirsttemp(l : longint);
  362.  
  363.       begin
  364.          { generates problems
  365.          if (l mod 4 <> 0) then dec(l,l mod 4);}
  366.          firsttemp:=l;
  367.          maxtemp := l;
  368.          lastoccupied:=l;
  369.       end;
  370.  
  371.     function gettempofsize(size : longint) : longint;
  372.  
  373.       var
  374.          last,hp : pfreerecord;
  375.  
  376.       begin
  377.          { this code comes from the heap management of FPC ... }
  378.          if (size mod 4)<>0 then
  379.            size:=size+(4-(size mod 4));
  380.            if assigned(tmpfreelist) then
  381.              begin
  382.                 last:=nil;
  383.                 hp:=tmpfreelist;
  384.                 while assigned(hp) do
  385.                   begin
  386.                      { first fit }
  387.                      if hp^.size>=size then
  388.                        begin
  389.                           gettempofsize:=hp^.pos;
  390.                           if hp^.pos-size < maxtemp then
  391.                             maxtemp := hp^.size-size;
  392.                           { the whole block is needed ? }
  393.                           if hp^.size>size then
  394.                             begin
  395.                                hp^.size:=hp^.size-size;
  396.                                hp^.pos:=hp^.pos-size;
  397.                             end
  398.                           else
  399.                             begin
  400.                                if assigned(last) then
  401.                                  last^.next:=hp^.next
  402.                                else
  403.                                  tmpfreelist:=nil;
  404.                                dispose(hp);
  405.                             end;
  406.                           exit;
  407.                        end;
  408.                      last:=hp;
  409.                      hp:=hp^.next;
  410.                   end;
  411.              end;
  412.           { nothing free is big enough : expand temp }
  413.           gettempofsize:=lastoccupied-size;
  414.           lastoccupied:=lastoccupied-size;
  415.           if lastoccupied < maxtemp then
  416.             maxtemp := lastoccupied;
  417.       end;
  418.  
  419.     function gettempsize : longint;
  420.  
  421.       begin
  422.          { align local data to dwords }
  423.          if (maxtemp mod 4)<>0 then
  424.            dec(maxtemp,4+(maxtemp mod 4));
  425.          gettempsize:=-maxtemp;
  426.       end;
  427.  
  428.     procedure gettempofsizereference(l : longint;var ref : treference);
  429.  
  430.       var
  431.          tl : pfreerecord;
  432.  
  433.       begin
  434.          { do a reset, because the reference isn't used }
  435.          reset_reference(ref);
  436.          ref.offset:=gettempofsize(l);
  437.          ref.base:=procinfo.framepointer;
  438.          new(tl);
  439.          tl^.pos:=ref.offset;
  440.          tl^.size:=l;
  441.          tl^.next:=templist;
  442.          templist:=tl;
  443. {$ifdef EXTDEBUG}
  444.          tl^.line:=current_module^.current_inputfile^.line_no;
  445. {$endif}
  446.       end;
  447.  
  448.     function istemp(const ref : treference) : boolean;
  449.  
  450.       begin
  451.          istemp:=((ref.base=procinfo.framepointer) and
  452.            (ref.offset<firsttemp));
  453.       end;
  454.  
  455.     procedure ungettemp(pos : longint;size : longint);
  456.  
  457.       var
  458.          hp,newhp : pfreerecord;
  459.  
  460.       begin
  461.          if (size mod 4)<>0 then
  462.            size:=size+(4-(size mod 4));
  463.          if size = 0 then
  464.            exit;
  465.          if pos<=lastoccupied then
  466.            if pos=lastoccupied then
  467.              begin
  468.                 lastoccupied:=pos+size;
  469.                 hp:=tmpfreelist;
  470.                 newhp:=nil;
  471.                 while assigned(hp) do
  472.                   begin
  473.                      { conneting a free block }
  474.                      if hp^.pos=lastoccupied then
  475.                         begin
  476.                            if assigned(newhp) then newhp^.next:=nil
  477.                              else tmpfreelist:=nil;
  478.                            lastoccupied:=lastoccupied+hp^.size;
  479.                            dispose(hp);
  480.                            break;
  481.                         end;
  482.                      newhp:=hp;
  483.                      hp:=hp^.next;
  484.                   end;
  485.              end
  486.            else
  487.              begin
  488. {$ifdef EXTDEBUG}
  489.               Comment(V_Warning,'temp managment problem : ungettemp() pos < lastoccupied !');
  490. {$endif}
  491.              end
  492.          else
  493.            begin
  494.               new(newhp);
  495.               { size can be allways set }
  496.               newhp^.size:=size;
  497.               newhp^.pos := pos;
  498.               { if there is no free list }
  499.               if not assigned(tmpfreelist) then
  500.                 begin
  501.                    { then generate one }
  502.                    tmpfreelist:=newhp;
  503.                    newhp^.next:=nil;
  504.                    exit;
  505.                 end;
  506.               { search the position to insert }
  507.               hp:=tmpfreelist;
  508.               while assigned(hp) do
  509.                 begin
  510.                    { conneting two blocks ? }
  511.                    if hp^.pos+hp^.size=pos then
  512.                       begin
  513.                          inc(hp^.size,size);
  514.                          dispose(newhp);
  515.                          break;
  516.                       end
  517.                    { if the end is reached, then concat }
  518.                    else if hp^.next=nil then
  519.                      begin
  520.                         hp^.next:=newhp;
  521.                         newhp^.next:=nil;
  522.                         break;
  523.                      end
  524.                    { falls der n„chste Zeiger gr”áer ist, dann }
  525.                    { Einh„ngen                                 }
  526.                    else if hp^.next^.pos<=pos+size then
  527.                      begin
  528.                         { concat two blocks ? }
  529.                         if pos+size=hp^.next^.pos then
  530.                           begin
  531.                              newhp^.next:=hp^.next^.next;
  532.                              inc(newhp^.size,hp^.next^.size);
  533.                              dispose(hp^.next);
  534.                              hp^.next:=newhp;
  535.                           end
  536.                         else
  537.                           begin
  538.                              newhp^.next:=hp^.next;
  539.                              hp^.next:=newhp;
  540.                           end;
  541.                         break;
  542.                      end;
  543.                    hp:=hp^.next;
  544.                 end;
  545.            end;
  546.       end;
  547.  
  548.     procedure ungetiftemp(const ref : treference);
  549.  
  550.       var
  551.          tl,prev : pfreerecord;
  552.  
  553.       begin
  554.          if istemp(ref) then
  555.            begin
  556.               prev:=nil;
  557.               tl:=templist;
  558.               while assigned(tl) do
  559.                 begin
  560.                    if ref.offset=tl^.pos then
  561.                      begin
  562.                         ungettemp(ref.offset,tl^.size);
  563.                         if assigned(prev) then
  564.                           prev^.next:=tl^.next
  565.                         else
  566.                           templist:=tl^.next;
  567.                         dispose(tl);
  568.                         exit;
  569.                      end
  570.                    else
  571.                      begin
  572.                         prev:=tl;
  573.                         tl:=tl^.next;
  574.                      end;
  575.                 end;
  576. {$ifdef EXTDEBUG}
  577.               Comment(V_Warning,'Internal: temp managment problem : '+
  578.                 'temp not found for release at offset '+tostr(ref.offset));
  579. {$endIf}
  580.            end;
  581.       end;
  582.  
  583. begin
  584.    usableregs:=[R_EAX,R_EBX,R_ECX,R_EDX];
  585. {$ifdef SUPPORT_MMX}
  586.    usableregs:=usableregs+[R_MM0..R_MM6];
  587. {$endif SUPPORT_MMX}
  588.    c_usableregs:=4;
  589.    tmpfreelist:=nil;
  590.    templist:=nil;
  591. end.
  592. {
  593.   $Log: tgeni386.pas,v $
  594.   Revision 1.1.1.1  1998/03/25 11:18:15  root
  595.   * Restored version
  596.  
  597.   Revision 1.9  2036/02/07 09:26:57  florian
  598.     * more fixes to get -Ox work
  599.  
  600.   Revision 1.8  1998/03/10 01:17:30  peter
  601.     * all files have the same header
  602.     * messages are fully implemented, EXTDEBUG uses Comment()
  603.     + AG... files for the Assembler generation
  604.  
  605.   Revision 1.7  1998/03/02 01:49:36  peter
  606.     * renamed target_DOS to target_GO32V1
  607.     + new verbose system, merged old errors and verbose units into one new
  608.       verbose.pas, so errors.pas is obsolete
  609.  
  610.   Revision 1.6  1998/02/13 10:35:52  daniel
  611.   * Made Motorola version compilable.
  612.   * Fixed optimizer
  613.  
  614.   Revision 1.5  1998/02/12 17:19:32  florian
  615.     * fixed to get remake3 work, but needs additional fixes (output, I don't like
  616.       also that aktswitches isn't a pointer)
  617.  
  618.   Revision 1.4  1998/02/12 11:50:50  daniel
  619.   Yes! Finally! After three retries, my patch!
  620.  
  621.   Changes:
  622.  
  623.   Complete rewrite of psub.pas.
  624.   Added support for DLL's.
  625.   Compiler requires less memory.
  626.   Platform units for each platform.
  627.  
  628.   Revision 1.3  1998/02/04 22:02:46  florian
  629.     + complete handling of MMX registers
  630.  
  631.   Revision 1.2  1998/01/07 00:13:44  michael
  632.   Restored released version (plus fixes) as current
  633.  
  634.   Revision 1.1.1.1  1997/11/27 08:33:03  michael
  635.   FPC Compiler CVS start
  636.  
  637.   Pre-CVS log:
  638.  
  639.   FK   Florian Klaempfl
  640.   PM   Pierre Muller
  641.   +    feature added
  642.   -    removed
  643.   *    bug fixed or changed
  644.  
  645.   History (started with version 0.9.0):
  646.        7th december 1996:
  647.          * some code from Pierre Muller inserted
  648.            makes the use of the stack more efficient
  649.        20th november 1997:
  650.          * tempsize is multiple of 4 for alignment (PM), buggy commented (PM)
  651. }
  652.  
  653.